Задание 1
library(readr)
library(plotly)
## Loading required package: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(ggplot2)
library(rstatix)
##
## Attaching package: 'rstatix'
## The following object is masked from 'package:stats':
##
## filter
library(reshape2)
library(corrplot)
## corrplot 0.92 loaded
library(pheatmap)
library(stats)
library(gridExtra)
library(umap)
life_expectancy_data <- read_rds("/Users/juliat/Downloads/life_expectancy_data.RDS.rds.rds")
Задание 2
# 'Life expectancy' vs 'GDP'
p <- plot_ly(data = life_expectancy_data, x = ~GDP, y = ~`Life expectancy`,
type = 'scatter', mode = 'markers',
color = ~continent, marker = list(size = 10))
p
Задание 3
# Фильтр данных для стран Африки и Америки
africa_america_data <- life_expectancy_data[life_expectancy_data$continent %in% c("Africa", "Americas"),]
# t-test
test_result <- t_test(`Life expectancy` ~ continent, data = africa_america_data)
# p-value
p_value <- test_result$p
p_value
## [1] 1.31e-20
# Визуализация ggplot2 + rstatix
ggplot(africa_america_data, aes(x = continent, y = `Life expectancy`, fill = continent)) +
geom_boxplot() +
geom_jitter(width = 0.2, size = 2, alpha = 0.5) +
annotate("text", x = 1.5, y = max(africa_america_data$`Life expectancy`),
label = paste("p-value:", round(p_value, 3)), size = 5) +
theme_minimal() +
labs(title = "Life Expectancy Comparison: Africa vs America", y = "Life Expectancy", x = "Continent")
Задание 4
# Конвертация data.table в data.frame
life_expectancy_df <- as.data.frame(life_expectancy_data)
# Выбор только числовых столбцов и исключение 'Year'
numeric_data <- life_expectancy_df[sapply(life_expectancy_df, is.numeric)]
numeric_data$Year <- NULL # исключение 'Year'
# Расчет корреляционной матрицы
cor_matrix <- cor(numeric_data, use = "complete.obs")
# Корреляционная матрица для ggplot
melted_cor_matrix <- melt(cor_matrix)
# Создание heatmap
ggplot(melted_cor_matrix, aes(Var1, Var2, fill = value)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(fill = "Correlation")
# Создание correlogram
corrplot(cor_matrix, method = "circle")
Задание 5
# Вычисление матрицы расстояний, используя евклидово расстояние
dist_matrix <- dist(numeric_data, method = "euclidean")
# Иерархическая кластеризация
hc <- hclust(dist_matrix, method = "complete")
# Построение дендрограммы
plot(hc)
Задание 6
# Создание heatmap с иерархической кластеризацией
pheatmap(numeric_data,
scale = "row",
clustering_distance_rows = "euclidean",
clustering_distance_cols = "euclidean",
clustering_method = "complete")
# Кластеры в строках: Дендрограмма в левой части тепловой карты объединяет сходные наблюдения. Если строки представляют разные страны или организации, то страны, расположенные ближе друг к другу на дендрограмме, имеют более схожие профили по всем измеряемым показателям.
# Кластеры в столбцах: Дендрограмма в верхней части объединяет схожие показатели. Например, GDP и GNI расположены близко друг к другу, что говорит о том, что они имеют схожую структуру по всем наблюдениям. Это вполне ожидаемо, поскольку GDP и GNI являются экономическими показателями, которые часто движутся вместе.
# Цвета тепловой карты: Цвета на тепловой карте соответствуют масштабированным значениям показателей. В данном случае, поскольку строки масштабированы , цвета показывают, как значение каждого показателя для данного наблюдения сопоставляется со средним значением для данного показателя. Темно-красный цвет указывает на значения, значительно превышающие среднее значение, а темно-синий - на значения, значительно ниже среднего.
# Показатели, которые постоянно имеют темно-красный цвет во многих наблюдениях, могут быть выше среднего значения в данном наборе данных, что указывает на потенциальные области, требующие внимания или внимания.
# Показатели, постоянно окрашенные в темно-синий цвет, могут выделять области, в которых результаты наблюдений в целом ниже среднего, что может свидетельствовать об областях, требующих улучшения или вызывающих озабоченность.
# Кластеры показателей или наблюдений могут выявить закономерности, требующие дальнейшего изучения. Например, кластер показателей, связанных со здоровьем, может указывать на группу стран со схожими результатами в области здравоохранения.
Задание 7
# Выполнить РСА
pca_result <- prcomp(numeric_data, center = TRUE, scale. = TRUE)
# Сводка результатов PCA
summary(pca_result)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.7526 1.4841 1.3952 1.17177 1.08375 0.96347 0.9288
## Proportion of Variance 0.3988 0.1159 0.1025 0.07227 0.06182 0.04886 0.0454
## Cumulative Proportion 0.3988 0.5147 0.6172 0.68945 0.75126 0.80012 0.8455
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.85740 0.69263 0.68937 0.59106 0.54986 0.47085 0.36596
## Proportion of Variance 0.03869 0.02525 0.02501 0.01839 0.01591 0.01167 0.00705
## Cumulative Proportion 0.88421 0.90946 0.93447 0.95286 0.96877 0.98044 0.98749
## PC15 PC16 PC17 PC18 PC19
## Standard deviation 0.34546 0.26941 0.20224 0.06968 1.017e-15
## Proportion of Variance 0.00628 0.00382 0.00215 0.00026 0.000e+00
## Cumulative Proportion 0.99377 0.99759 0.99974 1.00000 1.000e+00
# Построение графика дисперсии
plot(pca_result, type = "l")
# Извлечение оценок (координат главных компонент)
scores <- as.data.frame(pca_result$x)
# ggplot первых двух главных компонент
ggplot(scores, aes(PC1, PC2)) +
geom_point() +
xlab(paste("PC1 - ", round(summary(pca_result)$importance[2,1]*100, 1), "%")) +
ylab(paste("PC2 - ", round(summary(pca_result)$importance[2,2]*100, 1), "%")) +
theme_minimal()
Задание 8
# Вывести названия столбцов набора данных
print(colnames(life_expectancy_data))
## [1] "Country"
## [2] "Year"
## [3] "Gender"
## [4] "Life expectancy"
## [5] "Unemployment"
## [6] "Infant Mortality"
## [7] "GDP"
## [8] "GNI"
## [9] "Clean fuels and cooking technologies"
## [10] "Per Capita"
## [11] "Mortality caused by road traffic injury"
## [12] "Tuberculosis Incidence"
## [13] "DPT Immunization"
## [14] "HepB3 Immunization"
## [15] "Measles Immunization"
## [16] "Hospital beds"
## [17] "Basic sanitation services"
## [18] "Tuberculosis treatment"
## [19] "Urban population"
## [20] "Rural population"
## [21] "Non-communicable Mortality"
## [22] "Sucide Rate"
## [23] "continent"
# Добавить оценки PCA к исходному массиву данны
biplot_data <- cbind(life_expectancy_data, PCA1 = pca_result$x[,1], PCA2 = pca_result$x[,2])
# Создание интерактивного biplot
p <- plot_ly(data = biplot_data, x = ~PCA1, y = ~PCA2, type = 'scatter', mode = 'markers',
text = ~Country, color = ~continent, colors = 'Set1',
marker = list(size = 10, opacity = 0.5)) %>%
layout(title = 'PCA Biplot',
xaxis = list(title = 'PC1'),
yaxis = list(title = 'PC2'))
# Вывести график
p
Задание 9
# Задание 7: Интерпретация результатов РСА-анализа
# Результаты PCA-анализа показывают, что первая главная компонента (PC1) объясняет около 39,88% дисперсии данных, а вторая главная компонента (PC2) - около 11,59%. В совокупности первые две компоненты объясняют более 51,47% дисперсии. Это значительная величина, но она также указывает на то, что в данных есть и другие факторы и измерения, которые вносят вклад в оставшуюся дисперсию.
# Представленная диаграмма распределения отображает дисперсии главных компонент, имея типичную форму "локтя", указывающую на то, что первые несколько компонент объясняют наиболее значительную дисперсию, а последующие компоненты вносят меньший вклад. При принятии решения о том, сколько компонентов оставить, обычно учитывается место расположения этого локтя, предполагая, что компоненты, расположенные за этой точкой, вносят меньший вклад в объяснение дисперсии и могут рассматриваться как шум.
# На биплоте показано, как различные страны (представленные точками) отображаются на первые две главные компоненты. Цветовое кодирование по континентам указывает на возможную кластеризацию по континентам. Например, страны одного и того же континента могут объединяться в кластеры, что говорит о сходстве ожидаемой продолжительности жизни и других переменных, включенных в PCA.
# Задание 8: Интерпретация биплота PCA
# biplot PCA объединяет в себе диаграмму рассеяния оценок первых двух главных компонент с векторами, представляющими нагрузки каждой переменной, которые не видны на общем изображении биплограммы.
# Интерпретация результатов PCA и биплота
# Результаты PCA свидетельствуют о том, что ВВП, показатели здоровья и другие социально-экономические факторы действительно влияют на продолжительность жизни, но делают это сложными способами, которые не могут быть полностью отражены только географическим положением. Кластеризация точек по континентам свидетельствует о сходстве регионов, однако их перекрытие указывает на сложное взаимодействие различных факторов, влияющих на продолжительность жизни.
# В целом, PCA показывает, что существует несколько ключевых измерений, по которым данные различаются наиболее существенно, и эти измерения, скорее всего, связаны с сочетанием экономических, медицинских и социальных факторов.
Задание 10
# Выполнение UMAP
umap_result <- umap(numeric_data)
umap_data <- as.data.frame(umap_result$layout)
colnames(umap_data) <- c("UMAP1", "UMAP2")
# Визуализация с использованием ggplot2
ggplot(umap_data, aes(UMAP1, UMAP2)) +
geom_point() +
theme_minimal() +
labs(title = "UMAP Projection")
# Выполнение PCA
pca_result <- prcomp(numeric_data, center = TRUE, scale. = TRUE)
scores <- as.data.frame(pca_result$x)
# Визуализация с использованием ggplot2
ggplot(scores, aes(PC1, PC2)) +
geom_point() +
theme_minimal() +
labs(title = "PCA Projection")
# Распределение точек:
# PCA: Точки в проекции PCA распределяются более равномерно по всему пространству. Это свидетельствует о том, что PCA сохраняет глобальную структуру данных и различия между точками в исходном пространстве.
# UMAP: Точки в проекции UMAP формируют несколько четко различимых кластеров. Это указывает на то, что UMAP лучше отражает локальные структуры и возможно подчеркивает более тонкие группировки в данных.
# Сохранение структуры данных:
# PCA: Как линейный метод, PCA стремится сохранить дистанцию и направление максимальной дисперсии, что может привести к менее очевидной кластеризации, если данные имеют сложную или нелинейную структуру.
# UMAP: UMAP, используя нелинейный подход, часто лучше отображает структуру данных, когда важны локальные отношения, что может быть более информативным для определенных видов анализа данных.
# Интерпретация:
# PCA: Интерпретация PCA может быть более прямолинейной, так как она отражает основные направления вариативности в данных.
# UMAP: Интерпретация результатов UMAP может потребовать более глубокого понимания структуры данных и способа формирования кластеров, так как метод может выявлять сложные нелинейные зависимости.
# Выбор метода:
# Выбор между PCA и UMAP может зависеть от целей анализа. Для понимания глобальных отношений и основных направлений дисперсии, PCA может быть предпочтительнее. Если же важнее выявить скрытые локальные шаблоны или кластеры, UMAP может быть предпочтительнее.
Задание 11
set.seed(123) # For reproducibility
random_cols <- sample(names(numeric_data), 5)
reduced_data <- numeric_data[ , !(names(numeric_data) %in% random_cols)]
pca_reduced <- prcomp(reduced_data, scale = TRUE)
summary(pca_reduced)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.3562 1.3934 1.2683 1.15126 0.95368 0.8807 0.71828
## Proportion of Variance 0.3966 0.1387 0.1149 0.09467 0.06496 0.0554 0.03685
## Cumulative Proportion 0.3966 0.5352 0.6501 0.74480 0.80977 0.8652 0.90202
## PC8 PC9 PC10 PC11 PC12 PC13
## Standard deviation 0.68711 0.58741 0.50867 0.41594 0.34317 0.07115
## Proportion of Variance 0.03372 0.02465 0.01848 0.01236 0.00841 0.00036
## Cumulative Proportion 0.93574 0.96039 0.97887 0.99123 0.99964 1.00000
## PC14
## Standard deviation 4.382e-16
## Proportion of Variance 0.000e+00
## Cumulative Proportion 1.000e+00
library(stats)
# Function to perform PCA after dropping 5 random columns
perform_pca <- function(data, seed) {
set.seed(seed) # Set seed for reproducibility
cols_to_remove <- sample(colnames(data), 5) # Randomly select 5 columns
data_reduced <- data[, !(colnames(data) %in% cols_to_remove)] # Drop the columns
pca_result <- prcomp(data_reduced, center = TRUE, scale. = TRUE) # Perform PCA
summary(pca_result) # Summarize the PCA results
}
# Perform PCA three times with different random columns removed
pca1 <- perform_pca(numeric_data, seed = 1)
pca2 <- perform_pca(numeric_data, seed = 2)
pca3 <- perform_pca(numeric_data, seed = 3)
# Print the summaries to compare the results
print(pca1)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.485 1.4284 1.10309 1.01042 0.96005 0.88666 0.7474
## Proportion of Variance 0.441 0.1457 0.08691 0.07292 0.06584 0.05615 0.0399
## Cumulative Proportion 0.441 0.5868 0.67369 0.74662 0.81245 0.86860 0.9085
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.65115 0.6057 0.43186 0.37345 0.34846 0.20658 4e-16
## Proportion of Variance 0.03029 0.0262 0.01332 0.00996 0.00867 0.00305 0e+00
## Cumulative Proportion 0.93879 0.9650 0.97832 0.98828 0.99695 1.00000 1e+00
print(pca2)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.3333 1.4317 1.2974 1.09192 1.02227 0.88764 0.75953
## Proportion of Variance 0.3889 0.1464 0.1202 0.08516 0.07464 0.05628 0.04121
## Cumulative Proportion 0.3889 0.5353 0.6555 0.74065 0.81530 0.87158 0.91278
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.64742 0.59422 0.4364 0.35741 0.29076 0.20275 0.07051
## Proportion of Variance 0.02994 0.02522 0.0136 0.00912 0.00604 0.00294 0.00036
## Cumulative Proportion 0.94272 0.96794 0.9816 0.99067 0.99671 0.99964 1.00000
print(pca3)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.5338 1.2188 1.14423 0.97404 0.93398 0.82869 0.81703
## Proportion of Variance 0.4586 0.1061 0.09352 0.06777 0.06231 0.04905 0.04768
## Cumulative Proportion 0.4586 0.5647 0.65820 0.72597 0.78828 0.83733 0.88501
## PC8 PC9 PC10 PC11 PC12 PC13
## Standard deviation 0.68906 0.62750 0.54555 0.46948 0.37063 0.29308
## Proportion of Variance 0.03391 0.02813 0.02126 0.01574 0.00981 0.00614
## Cumulative Proportion 0.91892 0.94705 0.96831 0.98405 0.99386 1.00000
## PC14
## Standard deviation 3.204e-16
## Proportion of Variance 0.000e+00
## Cumulative Proportion 1.000e+00
# Видно, что на каждой итерации PCA наблюдается изменение объясненной дисперсии. Хотя суммарная дисперсия, объясненная компонентами, остается близкой к 1 (или 100%), распределение по отдельным компонентам меняется. Например: доля дисперсии, объясненной первой главной компонентой (PC1), в разных итерациях изменяется от примерно 39% до более чем 45%.
# Суммарная дисперсия, объясненная первыми двумя компонентами, колеблется от 54% до 58%. Эти изменения обусловлены тем, что каждый раз удаляются различные признаки, что приводит к изменению базовой структуры данных, которую отражает PCA. Каждый набор признаков вносит свой вклад в общую дисперсию, и их удаление может перераспределить долю дисперсии, объясняемую каждой главной компонентой.
# Этот эксперимент иллюстрирует чувствительность PCA к конкретному набору признаков, включенных в анализ. Поскольку PCA опирается на дисперсию признаков, удаление различных признаков может существенно повлиять на результаты. Именно поэтому PCA, как и снижение размерности в целом, можно считать несколько нестабильным или чувствительным к изменениям исходных данных.
Задание 12
numeric_data$africa <- ifelse(life_expectancy_data$continent == "Africa", 1, 0)
numeric_data$oceanic <- ifelse(life_expectancy_data$continent == "Oceania", 1, 0)
pca_dummy <- prcomp(numeric_data[, c("africa", "oceanic")], scale = TRUE)
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
fviz_pca_ind(pca_dummy)
# График представляет собой biplot PCA с двумя измерениями, обозначенными как Dim1 и Dim2, которые, представляют собой первые две главные компоненты. Проценты в метках (58,7% для Dim1 и 41,3% для Dim2) указывают на количество дисперсии, которую каждая главная компонента улавливает из набора данных. Вместе они отражают 100% дисперсии, поскольку в PCA включены только две фиктивные переменные ("Африка" и "Океания"), что позволяет свести данные только к двум измерениям.
# biplot PCA обычно показывает как баллы (преобразованные координаты исходных точек данных в пространстве главных компонент), так и нагрузки (коэффициенты исходных переменных). Однако, поскольку были использованы только фиктивные переменные, biplot не дает возможности для интерпретации, поскольку фиктивные переменные обычно принимают бинарные значения (0 или 1), и их использование в PCA может быть проблематичным.
# Кроме того, PCA - это метод, основанный на непрерывных переменных и предполагающий линейную зависимость между ними. Бинарные переменные, особенно неравномерно распределенные (например, редко встречающаяся "Океания" по сравнению с "Африкой"), могут исказить результаты PCA и сделать интерпретацию главных компонент менее понятной.
# Таким образом, проведенный PCA с фиктивными переменными для континентов отражает всю дисперсию бинарных данных, но не позволяет получить значимое представление о структуре данных, как это было бы при применении традиционного PCA к непрерывным переменным.